home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / UCB Logo 3.0 ƒ / sources / standard source / intern.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-08-14  |  3.9 KB  |  149 lines  |  [TEXT/ttxt]
  1. /*
  2.  *      intern.c        logo data interning module              dvb
  3.  *
  4.  *    Copyright (C) 1993 by the Regents of the University of California
  5.  *
  6.  *      This program is free software; you can redistribute it and/or modify
  7.  *      it under the terms of the GNU General Public License as published by
  8.  *      the Free Software Foundation; either version 2 of the License, or
  9.  *      (at your option) any later version.
  10.  *  
  11.  *      This program is distributed in the hope that it will be useful,
  12.  *      but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.  *      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.  *      GNU General Public License for more details.
  15.  *  
  16.  *      You should have received a copy of the GNU General Public License
  17.  *      along with this program; if not, write to the Free Software
  18.  *      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  *
  20.  */
  21.  
  22. #include "logo.h"
  23. #include "globals.h"
  24.  
  25. NODE *hash_table[HASH_LEN] = {NIL};
  26.  
  27. void map_oblist(void (*fcn)())
  28. {
  29.     int i;
  30.     NODE *nd;
  31.  
  32.     for (i = 0; i < HASH_LEN; i++)
  33.     for (nd = hash_table[i]; nd != NIL; nd = cdr(nd))
  34.         (*fcn) (car(nd));
  35. }
  36.  
  37. int hash(char *s, int len)
  38.     /* Map S to an integer in the range 0 .. HASH_LEN-1. */
  39.     /* Method attributed to Peter Weinberger, adapted from Aho, Sethi, */
  40.     /* and Ullman's book, Compilers: Principles, Techniques, and */
  41.     /* Tools; figure 7.35. */
  42. {
  43.     unsigned int h = 0, g;
  44.  
  45.     while (--len >= 0) {
  46.     h = (h << 4) + *s++;
  47.     g = h & (0xf << (WORDSIZE-4));
  48.     if (g != 0) {
  49.         h ^= g ^ (g >> (WORDSIZE-8));
  50.     }
  51.     }
  52.     return h % HASH_LEN;
  53. }
  54.  
  55. NODE *make_case(NODE *casestrnd, NODE *obj)
  56. {
  57.     NODE *new_caseobj, *clistptr;
  58.  
  59.     clistptr = caselistptr__object(obj);
  60.     new_caseobj = make_caseobj(casestrnd, obj);
  61.     setcdr(clistptr, cons(new_caseobj, cdr(clistptr)));
  62.     return(new_caseobj);
  63. }
  64.  
  65. NODE *make_object(NODE *canonical, NODE *proc, NODE *val,
  66.           NODE *plist, NODE *casestrnd)
  67. {
  68.     NODE *temp;
  69.  
  70.     temp = cons_list(0, canonical, proc, val, plist,
  71.              make_intnode((FIXNUM)0), END_OF_LIST);
  72.     make_case(casestrnd, temp);
  73.     return(temp);
  74. }
  75.  
  76. NODE *make_instance(NODE *casend, NODE *lownd)
  77. {
  78.     NODE *obj;
  79.     int hashind;
  80.  
  81.     /* Called only if arg isn't already in hash table */
  82.  
  83.     obj = make_object(lownd, UNDEFINED, UNBOUND, NIL, casend);
  84.     hashind = hash(getstrptr(lownd), getstrlen(lownd));
  85.     push(obj,(hash_table[hashind]));
  86.     return car(caselist__object(obj));
  87. }
  88.  
  89. NODE *find_instance(NODE *lownd)
  90. {
  91.     NODE *hash_entry, *thisobj;
  92.     int cmpresult;
  93.  
  94.     hash_entry = hash_table[hash(getstrptr(lownd), getstrlen(lownd))];
  95.  
  96.     while (hash_entry != NIL) {
  97.     thisobj = car(hash_entry);
  98.     cmpresult = compare_node(lownd, canonical__object(thisobj), FALSE);
  99.     if (cmpresult == 0)
  100.         break;
  101.     else
  102.         hash_entry = cdr(hash_entry);
  103.     }
  104.     if (hash_entry == NIL) return(NIL);
  105.     else return(thisobj);
  106. }
  107.  
  108. int case_compare(NODE *nd1, NODE *nd2)
  109. {
  110.     if (backslashed(nd1) && backslashed(nd2)) {
  111.     if (getstrlen(nd1) != getstrlen(nd2)) return(1);
  112.     return(strncmp(getstrptr(nd1), getstrptr(nd2),
  113.                getstrlen(nd1)));
  114.     }
  115.     if (backslashed(nd1) || backslashed(nd2))
  116.     return(1);
  117.     return(compare_node(nd1, nd2, FALSE));
  118. }
  119.  
  120. NODE *find_case(NODE *strnd, NODE *obj)
  121. {
  122.     NODE *clist;
  123.  
  124.     clist = caselist__object(obj);
  125.     while (clist != NIL &&
  126.         case_compare(strnd, strnode__caseobj(car(clist))))
  127.     clist = cdr(clist);
  128.     if (clist == NIL) return(NIL);
  129.     else return(car(clist));
  130. }
  131.  
  132. NODE *intern(NODE *nd)
  133. {
  134.     NODE *obj, *casedes, *lownd;
  135.  
  136.     if (nodetype(nd) == CASEOBJ) return(nd);
  137.     nd = valref(cnv_node_to_strnode(nd));
  138.     lownd = make_strnode(getstrptr(nd), (char *)NULL,
  139.              getstrlen(nd), STRING, noparitylow_strnzcpy);
  140.     if ((obj = find_instance(lownd)) != NIL) {
  141.     if ((casedes = find_case(nd, obj)) == NIL)
  142.         casedes = make_case(nd, obj);
  143.     } else
  144.     casedes = make_instance(nd, lownd);
  145.     deref(nd);
  146.     gcref(lownd);
  147.     return(casedes);
  148. }
  149.